Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / am68k.m68 < prev next >

Wrap

Text File | 1988-08-16 | 68.5 KB | 2,377 lines

; Kermit.m68 - a telecommunications & error free file transfer program ; Version 1.0 - basic version to bridge the gap ; Author: robert p. rubendunst, soft machines ; Based on kermit.c from Columbia University. Some obvious code optimization ; and routine consolidation COULD have been done, but was not done to make ; conversion and documentaion easier. However, this version of KERMIT does ; support eight-bit data paths, while kermit.c does not. ; (C) 1984 Soft Machines. All rights reserved. ; Edit History: ; started 09-07-84 rpr ; first non-alpha communication 10/5/84 with ibm pc. ; added 7 bit mode to allow use with ELS... 10/23/84 rpr ; AMUS release (clean-up same TRMDEF use) 12/3/84 rpr ; Permission is granted to any individual or institution to copy or use this ; software and the routines described in it, except for explicitly commercial ; purposes. This software must not be sold to any person or institution. ;;;;;;;;;;;;;;;;;;;;;;;;;;;; D I S C L A I M E R ;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; No warranty of the software or of the accuracy of the documentation ;; ;; surrounding it is expressed or implied, and neither the authors, ;; ;; Columbia University, Soft Machines, or AMUS acknowledge any liability ;; ;; resulting from program or documentation errors. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; usage format: ; KERMIT <TRMDEF-NAME> <escape character> ; then enter ? or HELP for use hints. SEARCH SYS SEARCH SYSSYM SEARCH TRM ; supplementary symbols for finding file type & size D.LEN=D.WRK D.ACT=D.LEN+4 D.1ST=D.ACT+10 ; symbol definitions TRUE = -1 FALSE = 1 PAKSIZ = 94. ; max packet size SOH = 1. ; default MARK character CR = 13. ; ASCII carriage return SPACE = 32. ; ASCII SP DEL = 127. ; ASCII DEL ESCCHR = '^ ; default escape character TRIES = 10. ; number of packet tries MYQUOT = '# ; control-quoting MYPAD = 0 ; number of pad chars MYPCHR = 0 ; the pad character I need MYEOL = 0 ; my end of line character MYTIME = 08. ; seconds before timeout MYBIN = 'Y ; binary qoute mode MYCHK = '2 ; try to use 2 byte cheksums MAXTIM = 60. ; maximum timeout MINTIM = 2 ; minimum timeout period ; This macro is used to read a packet DEFINE RPACK LEN,SEQ,PACKET,TYPE LEA A3,PACKET CALL RECPAK SSTS D7 MARG MOVB, D2,LEN MARG MOVB, D3,SEQ MARG MOVB, D4,TYPE LCC D7 ENDM ; This macro sends a packet to the REMOTE DEFINE SPACK TYPE,SEQ,SIZE,PACKET LEA A3,PACKET CCLR SIZE,D2 CCLR SEQ,D3 CCLR TYPE,D4 MARG MOVB, SIZE,D2 MARG MOVB, SEQ,D3 MARG MOVB, TYPE,D4 CALL SNDPAK ENDM ; This macro assembles argument linkage opcodes only where the default ; argument is not used. This provides more readable code without adding ; unecessary instructions. ; For example, if D2 is the standard data link register, the macro ; ARG MOVW D2,D2 ; will not produce an assembly line, but ; ARG MOVW D2,D3 ; will assemble the line MOVW D2,D3 DEFINE MARG OPCODE, SRC, DST NTYPE ...X,SRC NTYPE ...Y,DST IF NE,...X-...Y,OPCODE SRC,DST ENDM ASECT ; This macro is used to pre-clear result variables before a packet call ; IF they are not registers. DEFINE CCLR ARG,REG NTYPE ...D,ARG NTYPE ...E,REG IF NE,...D-...E,CLR REG ENDM .=0 ; define the impure area for KERMIT. NOSYM ; CONNECT command variables and general REMOTE/LOCAL channel variable TNAME: BLKW 2 ; terminal name packed RAD50 SAVTDV: BLKL 1 ; address of saved TDV PSEUDO: BLKL 1 ; address of PSEUDO driver SAVJTP: BLKW 1 ; saved job status SAVSTS: BLKW 1 ; saved TRMDEF status SAVJCB: BLKL 1 ; saved attached job index REMOTE: BLKL 1 ; index to remote TRMDEF LOCAL: BLKL 1 ; index to local TRMDEF STIME: BLKL 1 ; start time of event FSIZE: BLKL 1 ; size of file in bytes KMETA: BLKB 1 ; escape character DONE: BLKB 1 ; done with kermit flag NOTALK: BLKB 1 ; flag that remote TRMDEF is job's. ECHO: BLKB 1 ; duplex flag 0 for full, 377 for half CCOUNT: BLKB 1 ; control-c count ATERM: BLKB 7 ; terminal name in ASCII EVEN FIO: BLKB D.DDB ; file I/O ddb area ; KERMIT packet receiver variables CSUM: BLKW 1 ; checksum storage RTOUT: BLKL 1 ; time's up flag TIMINT: BLKL 1 ; # of seconds for timeout on sends ; Global variables for file section LOGIC: BLKB 1 ; 1=false, -1=true LDATA: BLKB 1 ; size of present data SPSIZ: BLKB 1 ; max send packet size PAD: BLKB 1 ; # of padding chars to send PADCHR: BLKB 1 ; pad character EOL: BLKB 1 ; EOL character to send N: BLKB 1 ; packet number MAXTRY: BLKB 1 ; max # of tries NUMTRY: BLKB 1 ; times this packet retried OLDTRY: BLKB 1 ; times previous packet retried BUFCNT: BLKB 1 ; # of data bytes for packet DEBUGO: BLKB 1 ; level of debug output (0=none) DING: BLKB 1 ; ding after each command flag (#0=yes) DF.EOL: BLKB 1 ; default EOL character DF.CHK: BLKB 1 ; default check type character DF.QBN: BLKB 1 ; default binary qouting character STATE: BLKB 1 ; present state of file transfer automaton QUOTE: BLKB 1 ; incoming quote char QBIN: BLKB 1 ; incoming QBIN char CHKT: BLKB 1 ; checksum method as ascii character CHKNOW: BLKB 1 ; checksum in use for this packet REPT: BLKB 1 ; repeat byte (not implemented yet) FLLEN: BLKB 1 ; filename length RMARK: BLKB 1 ; the MARK character RECPKT: BLKB PAKSIZ ; buffer for receiving packets PACKET: BLKB PAKSIZ ; another one NFILNM: BLKB 4 ; room for MARK,LEN,SEQ,TYPE FILNAM: BLKB 60. ; current filename BLKB 20. COPY: BLKB 60. ; ; copied filename BLKB PAKSIZ-80. EVEN KSIZE=. .=0 ; definition of KERMIT packet offsets MARK: BLKB 1 ; the MARK character LEN: BLKB 1 ; received LEN SEQ: BLKB 1 ; received sequence TYPE: BLKB 1 ; received type DATA: BLKB 1 ; beginning of DATA .=0 EVEN SYM REMMOD = T$IMI!T$ECS!T$DAT ; IMAGE, NOECHO mode bits T$ASN = 1_11. ; use this bit to "assign" a TRMDEF as busy. ; The following macros define character tranlation functions needed to ; implement the KERMIT protocol. ; MACROs to perform CHAR, UNCHAR & CTL functions via register argument. ; C H A R - change control character to printable character DEFINE CHAR DST ADDB #SPACE,DST ENDM ; U N C H A R -change CHARed control character back into a control character DEFINE UNCHAR DST SUBB #SPACE,DST ENDM ; CTL - UNCONTROLIFY a CHARACTER. CTL(CTL(CHAR)) leaves CHAR unchanged. DEFINE CTL DST XORB #64.,DST ENDM PSECT ; K E R M I T ; Main Kermit routine. The first three calls are performed the first time ; KERMIT is executed and establish the impure area, remote TRMDEF & meta char. ; The remaining calls comprise the get command -> process command loop. ; KERMIT: VMAJOR =1 VMINOR =0 VSUB = 0 VEDIT = 001. VWHO =0 ; The following routine displays important user information and ; should not be moved or removed. It also checks for the proper ; version of AMOSL. This module is self-contained, but not presented ; as source code to prevent user modification. PHDR -1,PV$RSM!PV$WSM!PV$RPD!PV$WPD,PH$REE!PH$REU RADIX 36. WORD 0VM4,0LDT,0KMO,8YP,0K0B,0LMA,0MZT,0NC0,0MLH WORD 0KTV,0LTB,0W,0FEI,1EJI,0D4X,741,7IA,0AAM,0AOU,18II,3K2,4S8,3 WORD 0BWC,0E8,0VMC,0VM4,1A,18II,3K2,0HT,0,0F,56G,2,0HX,0,0F,0BWC WORD 0E8,0VMC,9VN,1A3D,0HT,0,0F,0KCO,1A9,0,1S,0VM2,9VN,0G1,35R WORD 0KCU,0VM4,14,0BWC,0E8,0VMC,0VM4,15,19UI,3K2,0HT,0,0F,0KCQ WORD 0VM4,19,0BWC,0E8,0VMC,0VM8,10E4,1,0JCW,78,10SC,2,0JR4,70,0VM4 WORD 0EV3,0G91,0EH9,6DW,0K1E,0N75,0MLL,0MSL,0CV4,0FNX,0F2R,0NC0 WORD 0MLH,9PC,9WU,0LY8,6EQ,0J8S,0K1G,96A,0D,0VMA,1Z4,1ZH,93H,0KTD WORD 0LLU,0LF9,0DBJ,0MJK,6EN,0GUR,0CWD,0LK0,0MLR,6EE,0K11,0K8I WORD 0MJK,0K8F,0JZ4,0JFW,0LEP,0J8P,0J92,0MQO,6EH,0LT0,21T,0NWT WORD 0KTW,0MLV,0NDX,0LT5,6DX,0KTD,0LLU,0LF9,0DBJ,0MXS,6E9,0K10 WORD 0J90,0MLH,6EB,0J8Z,6EV,0M0C,0M03,0M0K,0M7M,0GM8,0F9L,0DOY,6DN WORD 0KMD,21G,93H,0K10,0MLY,0MSL,0MLH,0MQO,0KMS,0KTJ,6EQ,0LF0,6DD WORD 0MY6,0LTF,0JUD,0K1A,0N6Q,6DU,0M02,6DE,0B3O,9Q1,84G,7YB,2KQ WORD 0J72,0JFT,0N71,0M0C,6DF,6CM,0GUR,0CWD,0LY8,6ES,0K1F,0KTQ,0JMW WORD 0FA9,0MXS,0M06,6DV,0JG9,0JS0,0MZP,0LSX,0DIN,2O,0DFE,1EKC,3KX WORD 0KCK,0VM2,0J5K RADIX 8. ; You may add code here if you desire. CALL INIMEM ; initial memory area BNE EXEUNT ; need more memory-abort BMI 20$ ; TRMDEF already assigned ; first time entry. Check for CONNECT TRMDEF argument BYP ; scan past blanks CALL FNDASN ; find and assign user supplied TRMDEF BNE EXEUNT ; no match ORW #FIL!LOK,-10(A0) ; set file and locked in memo flags 20$: JOBIDX ANDW #^C<J.CCC>,@A6 ; clear control-c CALL CHOICE ; get user's command choice BNE 20$ CALL PROCES ; perform user's command TSTB DONE(A0) ; done ? BNE 40$ ; yes TSTB DING(A0) ; wake the user up? BEQ 20$ ; no TTYI ; yes BYTE 7,0 EVEN BR 20$ 40$: CLRB DONE(A0) ; E X E U N T - exit back to AMOS EXEUNT: EXIT ; I N I M E M ; This routine builds, clears and initializes the user's impure area. INIMEM: LEA A6,IMPNAM ; index impure module name SRCH @A6,A0,F.USR ; search user area for kermit BEQ 10$ ; already present-done GETIMP KSIZE,A0,100$ ; allocate impure area CLEAR @A0,KSIZE ; clear it LEA A6,IMPNAM MOV (A6)+,-6(A0) ; SET MODULE NAME TO KERMIT MOVW @A6,-2(A0) ; EXTENSION TO IMP ; do first time-only inits CALL INI2 CALL INIXFR ; init xfer section once. MOVB #ESCCHR,KMETA(A0) ; set CONNECT ESCAPE character LCC #PS.Z RTN ; finish re-entry inits 10$: CALL INI2 LCC #PS.N!PS.Z ; set N and Z if impure already there RTN ; not enough memory, so depart 100$: TYPECR <?Insufficient memory for KERMIT.> LCC #0 ; flag no memory RTN ; These values are inited every time KERMIT is executed. INI2: JOBIDX A6 MOVW JOBTYP(A6),SAVJTP(A0) ; save job type word MOV JOBTRM(A6),LOCAL(A0) RTN ; I N I X F R ; Initialize the the file transfer area INIXFR: MOVB #CR,DF.EOL(A0) ; set default EOL MOVB #MYCHK,DF.CHK(A0) ; set default check type MOVB #'Y,DF.QBN(A0) ; set optional binary quoter MOVB #96.,SPSIZ(A0) ; set max send size ; MOVB #SOH,RMARK(A0) ; define start of packet byte MOVB #MYQUOT,QUOTE(A0) ; set quote char MOV LOCAL(A0),A5 ; set index MOVB #MYPAD,PAD(A0) ; pad count MOVB #MYPCHR,PADCHR(A0) ; & character MOVB #TRIES,MAXTRY(A0) ; set max tries MOVB #'1,CHKT(A0) ; checksum type MOV #08.,TIMINT(A0) ; set timeout period RTN ; F N D A S N ; FNDASN finds the user specified TRMDEF, and assigns it to this job if found. ; "assigning" is done by setting bit 11 (^O4000). A TRMDEF is "busy" if this ; bit is already set. FNDASN: JOBIDX A6 MOV JOBTRM(A6),A5 ; index our own TRMDEF as default LIN ; user provide TRMDEF name? BEQ 25$ ; no-use our TRMDEF LEA A1,TNAME(A0) ; index terminal name storage PUSH A1 ; save for unpack PACK PACK ; pack the terminal name RAD50 POP A1 LEA A2,ATERM(A0) ; then unpack it for later UNPACK UNPACK CLRB @A2 ; save ASCII version for SHOW. MOV TNAME(A0),D6 ; D6 gets whole RAD50 terminal name LEA A3,TRMDFC ; index the head of the TRMDEF chain 10$: MOV @A3,D7 ; get link to next entry BEQ 100$ ; no matching TRMDEF MOV D7,A3 ; A3 indexs next element 20$: CMPL D6,4(A3) ; compare to this entry BNE 10$ ; try next one if no match ; TRMDEF is found. Check for prior use LEA A5,10(A3) ; index A5 to remote TRMDEF 25$: MOVW @A5,SAVSTS(A0) ; save the TRMDEF status BSET #< 11.-8.> ,1(A5) ; set "assigned" bit BNE 110$ ; already set by prior use-. MOV A5,REMOTE(A0) ; save pointer to remote TRMDEF MOV T.TDV(A5),SAVTDV(A0) ; save old TDV address ; find address of PSEUDO TRMDEF in memory for data transfer use. MOV SAVTDV(A0),PSEUDO(A0) ; preset any TDV in case PSEUDO is gone! MOV TRMTDC,A6 ; get base of tdv chain MOV #[PSE]_16.+[UDO],D7 ; D7 gets PSEUDO in RAD50 notation 30$: CMP D7,4(A6) ; match ? BEQ 40$ ; yes MOV @A6,A6 ; no-get next link MOV A6,D6 ; set flags BNE 30$ ; keep trying BR 50$ ; give up 40$: ADD #10,A6 ; add offset size of link word and name MOV A6,PSEUDO(A0) ; save address of PSEUDO driver 50$: CMP A5,LOCAL(A0) ; TRMDEF same as job's ? SETEQ NOTALK(A0) ; yes-flag KERMIT owns the data TRMDEF BEQ 60$ ; and bypass TDV swap. ; swap in PSEUDO TRMDEF instead of normal TDV because some TDVs will ; use multi-byte capture sequences or other translate routines, which will ; mess up incoming or outgoing data. MOV PSEUDO(A0),T.TDV(A5) ; substitute PSEUDO driver on remote ; unless TRMDEF is owned by KERMIT job, detach TRMDEF & JCB. 60$: MOV T.JLK(A5),A6 ; get JCB link MOV A6,SAVJCB(A0) ; save the JCB address for EXIT BEQ 70$ ; TRMDEF already detached-done TSTB NOTALK(A0) ; TRMDEF owned by KERMIT job? BNE 70$ ; yes-leave it attached CLR JOBTRM(A6) ; else detach TRMDEF from job CLR T.JLK(A5) ; and job from TRMDEF 70$: LCC #PS.Z RTN 100$: TYPECR <?No matching TRMDEF.> LCC #0 RTN 110$: TYPECR <?TRMDEF is assigned to another job.> LCC #0 RTN ; R A W T R M - set datacomm TRMDEF to pass all data intact, character mode. RAWTRM: MOV REMOTE(A0),A5 ; get index to the TRMDEF MOVW #REMMOD,D1 ; remote mode bits CALL SETSTS ; set the status RTN ; L I N T R M - set datacomm TRMDEF for normal AMOSL line mode. ; except echo is supressed if same TRMDEF for comm & commands LINTRM: TSTB NOTALK(A0) ; same TRMDEF for comm and job? BEQ 10$ ; no-just return ; enable line input mode so user can enter commands MOV REMOTE(A0),A5 ; yes-get index to the TRMDEF MOVW #^C<REMMOD>,D1 ; clear remote mode bits CALL SETSTS ; clear the status 10$: RTN ; P S E T D V - assign pseudo driver if data TRMDEF is owned by KERMIT job. PSETDV: TSTB NOTALK(A0) ; TRMDEF owned by KERMIT job? BEQ 10$ ; no-no need to swap MOV PSEUDO(A0),T.TDV(A5) ; swap in PSEUDO driver 10$: RTN ; O R G T D V - set normal terminal driver if data TRMDEF is owned by KERMIT job. ORGTDV: TSTB NOTALK(A0) ; TRMDEF owned by KERMIT job? BEQ 10$ ; no-no need to swap MOV SAVTDV(A0),T.TDV(A5) ; swap back real terminal driver 10$: RTN ; S N O O Z E - delay if data TRMDEF owned by KERMIT job. This gives user ; time to escape back to the other KERMIT and enter REC. SNOOZE: TSTB NOTALK(A0) ; data TRMDEF same as KERMITs? BEQ 10$ ; no - do not wait. SLEEP #15.*10000. ; yes - wait 15 seconds 10$: RTN ; E V L C H R ; EVLCHR evaluates the next non-blank character indexed by A2 and ; returns its value in D1. ; At exit, A2 is updated, and D1 contains the new character or 0. ; The Z flag is set if a character was encountered, else Z is clear. EVLCHR: CLR D1 ; pre-clear BYP LIN ; end of line? BEQ 100$ ; yes-no characters to process NUM ; else check for numeric BNE 10$ ; not numeric GTDEC ; get the value BR 40$ ; and use it ; process non-numeric 10$: MOVB (A2)+,D1 CMPB D1,#'^ ; control character prefix ? BNE 20$ ; no-use straight ASCII. LIN ; yes-check again for end of line BEQ 100$ ; no argument error. MOVB (A2)+,D1 ; else get next character AND #37,D1 ; mask to control character BR 40$ ; and exit 20$: CMPB D1,#SPACE ; compare to ASCII space BLO 100$ ; invalid argument 40$: LCC #PS.Z ; arg ok, value in D1 RTN 100$: LCC #0 ; arg is bad. RTN ; P R O M P T displays the KERMIT command prompt. PROMPT: TTYI BYTE 15 ASCII /Alpha-Kermit >/ BYTE 0 EVEN RTN ; C H O I C E - prompts the user for command & gets the command. CHOICE: CALL PROMPT ; prompt the user KBD 25$ ; get a command line in line mode BYP ; scan past blanks LIN ; end of line? BEQ CHOICE ; ignore blank lines LEA A1,KERCOM ; index argument list CALL COMAND ; match the command BEQ 30$ ; command matched ; no match - show user bad news. TYPE<? > 10$: LIN BEQ 20$ ; end of line. MOVB (A2)+,D1 ; else TTY ; type the BR 10$ ; character and loop 20$: TYPECR <? - undefined command.>; end error display 25$: LCC #0 ; flag no command RTN ; return 30$: LCC #PS.Z ; flag valid command RTN ; return ; C O M A N D - This subroutine compares the user's command string to the command ; list indexed by A1 (e.g. KERCOM). ; If a match is found, A1 will index the command offset for a tabled call. ; At entry, A1 indexs the command/subcommand list. A2 indexs user's string. ; At exit, Z is set to indicate the command was valid. ; If Z is set, A1 indexs the command offset word. ; ; This routine will match the entire command, or to a valid and unique subset ; of the command name as defined in the table structure. ; e.g. The string CON will match the command name CONNECT. COMAND: SUB #2,A1 ; adjustment for first entry BYP ; scan past seperators PUSH A2 ; save string address for compares LIN ; end of line? BEQ CHO.5 ; no command-exit. ; calculate address of next entry and place in A1. CHO.1: MOV @SP,A2 ; restore string pointer LEA A3,2(A1) ; A3 indexs next entry TSTW @A3 ; end of table ? BEQ CHO.5 ; yes-no match. MOV A3,A1 ; no-get address of command size word ADDW (A3)+,A1 ; and index to next command. CLR D5 MOVB (A3)+,D5 ; D5 gets qualifier size in bytes CHO.2: TRM ; check for end of word BEQ CHO.4 ; yes-check match count TSTB @A3 ; check for end of table entry BEQ CHO.1 ; must be wrong if so. CHO.3: MOVB @A2,D1 UCS ; convert to upper case CMPB D1,(A3)+ ; compare strings BNE CHO.4 ; until no match ADD #1,A2 ; advance A2 TST D5 ; check for minimum match length BEQ CHO.2 ; made it-stop counting SUB #1,D5 ; decrement byte count BR CHO.2 ; keep testing till line is terminated CHO.4: TST D5 ; good match has zero count BNE CHO.1 ; no good-try next TRM ; good match has no more data BNE CHO.1 POP ; toss old A2 LCC #PS.Z ; flag command match found RTN ; undefined command - Clear Z flag CHO.5: POP A2 LCC #0 RTN ; P R O C E S ; Process performs the process defined by the user command. ; At Entry, A1 indexs the word offset (from A1) of the command address PROCES: ADDW @A1,A1 ; do a tabled called by adding CALL @A1 ; offset @A1 to A1 and executing at RTN ; that new address. ; S E N D sends a file to the remote KERMIT using the KERMIT protocol. SEND: BYP CALL GFILNM ; get the filename BNE 100$ ; no filename CALL STARTT ; set start time LOOKUP FIO(A0) ; does the file exist? BEQ 10$ ; yes-ok, proceed BR 90$ ; no-abort with error 10$: CALL GTSIZE ; save file size in bytes TSTW FIO+D.ACT+2(A0) ; random file ? BMI 80$ ; yep-not allowed OPENI FIO(A0) ; open for input BNE 90$ ; abort & display error CALL RAWTRM ; put remote in data mode CALL SNOOZE ; delay if TRMDEF owned by KERMIT CALL PSETDV ; swap in PSEUDO driver if needed CALL SENDSW ; else send the file CALL LINTRM ; put remote in line mode CALL ORGTDV ; put back real TDV if PSEUDO used TSTB LOGIC(A0) ; did it work? BMI 20$ ; yes TYPECR <?SEND failed> ; no RTN 20$: CALL ENDTM ; show how long it took. RTN ; back to main routine. ; display a file error, like file type mismatch. 80$: MOVB #D$ETYP,FIO+D.ERR(A0) ; set file mismatch error 90$: 100$: CALL LFERR RTN ; L F E R R ; LFERR displays local file errors on the user's CRT LFERR: TSTB NOTALK(A0) ; do we have a user terminal? BNE 10$ ; no-do not print message. TYPE <Local file error, > PFILE FIO(A0) ; show filename ERRMSG FIO+D.ERR(A0), OT$TRM!OT$LSP ; and error message CRLF 10$: RTN ; R E C E I V - receive a file from remote KERMIT using the KERMIT protocol. RECEIV: MOV #60.,TIMINT(A0) ; 60 second timeout CALL STARTT ; get start time for stats. CALL PSETDV ; use pseudo if needed CALL RAWTRM ; remote trmdef to character mode CALL RECSW ; call receive state manager/switcher CALL LINTRM ; remote trmdef to line mode CALL ORGTDV ; return to real TDV if pseudo used TSTB LOGIC(A0) ; test for sucess BMI 10$ ; it worked TYPECR <?RECEIVE failed.> ; it didn't work RTN 10$: LOOKUP FIO(A0) ; do file lookup CALL GTSIZE ; to get file size CALL ENDTM ; show elapsed time & speed RTN ; G F I L N M ; This routine gets a filename and places it in FILNAM(A0) ; On exit, FLLEN(A0) contains the length in bytes. ; Z is set if the filename was valid. GFILNM: LIN ; end of line? BEQ 100$ ; no filename, abort INIT FIO(A0) ; init the ddb FSPEC FIO(A0),LST ; load the ddb with filespec ; now convert the name to KERMIT standard form which is NAME.EXT. ; We must delete all spaces from the filespec. LEA A2,FILNAM(A0) ; index the target area PUSH A2 ; and save the index LEA A1,FIO+D.FIL(A0) ; index the filname in the ddb UNPACK UNPACK ; put the ASCII filename @A1 MOVB #'.,(A2)+ ; add the comma UNPACK CLRB @A2 ; terminate it ; clean up the filespec by deleting space & other illegal characters. POP A2 ; restore pointer to filnam MOV A2,A1 ; A1 will be write pointer CLR D0 ; D0 counts valid chars we found 10$: MOVB @A2,D1 ; get current char in D7 BEQ 20$ ; end of line UCS ; convert to upper case CMPB D1,#'. ; current char a dot? BEQ 20$ ; yes -it is ok ALF ; is it alpha ? BEQ 20$ ; yes-use it. NUM ; or numeric ? BNE 25$ ; yes-use it 20$: MOVB D1,(A1)+ BEQ 30$ ; end of string ADD #1,D0 ; count how many we found 25$: ADD #1,A2 ; bump pointer BR 10$ ; continue scan 30$: CMP D0,#3 ; got at least x.x? BLO 100$ ; no-invalid filename MOVB D0,FLLEN(A0) ; save the length LCC #PS.Z ; valid filename received RTN 100$: LCC #0 ; bad filename given. RTN ; R F I L N M ; This routine gets the remote filename from NFILNM(A0) ; and places it in the FIO(A0) DDB. ; It then opens the file for input and returns the OPEN condition codes ; to the caller. Z is set if the open was succesful. RFILNM: LEA A2,FILNAM(A0) ; index the filnam LEA A1,COPY(A0) ; index copy buffer CLR D2 MOVB LDATA(A0),D2 ; d2 gets length of filename CMP D2,#30.-1 ; compare to max BLOS 10$ MOV #30.-1,D2 ; set max 10$: MOV #6,D0 ; set limit for filename 20$: ALF BEQ 40$ ; letters ok NUM BEQ 40$ ; numbers ok, too. CMPB @A2,#'. ; period? BEQ 70$ ; yes-start extension process. BNE 50$ ; no-toss bad char & continue 40$: MOVB @A2,(A1)+ ; save good character SUB #1,D0 ; decrement good char count 50$: ADD #1,A2 ; advance pointer TST D0 ; done with filename? BNE 20$ ; no ; wait for a period. 60$: CMPB @A2,#'. ; dot? BEQ 70$ ; yes-ok. ADD #1,A2 ; no-advance SUB #1,D0 ; count down BNE 60$ ; until a period 70$: MOVB #'.,(A1)+ ; buffer a dot. MOV #3.,D0 ; max size of extension. 80$: ALF BEQ 90$ ; ok NUM BNE 100$ ; not ok 90$: MOVB @A2,(A1)+ ; buffer o.k. character SUB #1,D0 ; count down 100$: ADD #1,A2 ; advance pointer TST D0 ; room for more BNE 80$ ; yes CLRB (A1)+ ; no- end with a null LEA A2,COPY(A0) ; index the new filename INIT FIO(A0) ; init the ddb FSPEC FIO(A0),KMT ; load the ddb with filespec LOOKUP FIO(A0) ; does file already exist? BNE 110$ ; no DSKDEL FIO(A0) ; yes-erase the old one 110$: OPENO FIO(A0) ; open it sequentially RTN ; Z is set if file found ; C O N N E C ; CONNEC is the local terminal <--> remote terminal conversational routine. ; User keypresses are sent (except the ESCAPE or KMETA character) to the ; remote computer & incoming characters form the remote are displayed on ; the user's CRT screen. CONNEC: TSTB NOTALK(A0) ; using same TRMDEF for in & out? BEQ 4$ ; no-ok. TTYL NONONO ; tell user it is a no-no RTN 4$: CALL RAWTRM ; set remote in "raw" mode. CALL SHOESC ; show the escape character in effect. MOV LOCAL(A0),A5 ; A5 indexs local TRMDEF MOV #T$IMI!T$ECS!T$ILC!T$XLT,D1 ; get char mode bits CALL SETSTS ; set them via breakpoint MOV A5,A4 ; A4 will be the local TRMDEF pointer MOV REMOTE(A0),A5 ; now A5 indexs REMOTE 10$: CTRLC 15$ ; user entered control-c? TST T.ICC(A4) ; LOCAL chars present ? BNE 20$ ; something to do TST T.ICC(A5) ; REMOTE chars present ? BNE 20$ ; something to do SLEEP #1000. ; take a 100 millisecond nap. BR 10$ ; see if the store needs minding now. ; handle control-c's by trapping them, unflagging them and sending them out. 15$: JOBIDX ANDW #^C<J.CCC>,@A6 ; clear control-c flag MOV #3,D1 ; get ASCII equivalent BR 37$ ; send it out ; enter here when we have some communications data to move 20$: TST T.ICC(A5) ; have remote input ? BEQ 30$ ; no TTYIN ; yes-grab a character TTY ; print it 30$: TCKI ; have LOCAL input ? BNE 40$ ; no local input KBD ; yes-get local input via KBD 35$: CMPB D1,KMETA(A0) ; escape character ? BEQ 100$ ; yes-leave ; check for half duplex echoing TSTB ECHO(A0) ; got echoing? BEQ 37$ ; no-full duplex CMPB D1,#SPACE ; printable? BHIS 36$ ; yes-echo it CMPB D1,#15 ; CR? BEQ 36$ ; yes-echo CMPB D1,#08. ; backspace? BEQ 36$ ; yes-echo CMPB D1,#12 ; line feed ? BNE 37$ ; ignore other ctl chars 36$: TTY ; yes-half duplex, so echo the character ; transmit a character to the remote site. 37$: TTYOUT ; send byte to REMOTE 40$: BR 10$ ; loop ; exit back to main routine, since user entered ESCAPE character. 100$: MOV LOCAL(A0),A5 ; index user's TRMDEF. MOV #^C<T$IMI!T$ECS!T$ILC!T$XLT>,D1 ; get char mode bits CALL SETSTS ; clear them via breakpoint ;; CALL LINTRM ; reset remote TRMDEF to line mode. RTN ; H E L P - inform user as to how KERMIT works. HELP: TTYL HLP1 LEA A1,KERCOM ; index argument list CALL COMAND ; see if we have an argument BNE 100$ ; no-show the whole list. ; show the selected help line by backing up to the start of it 4$: TSTB -(A1) ; backup to non-null BEQ 4$ 10$: MOVB -(A1),D1 ; look for null byte between command BNE 10$ ; and help strings. CRLF TTYL 1(A1) ; show the help message CRLF RTN ; Show help lines for all commands 100$: LEA A2,KERCOM ; index table 110$: MOV A2,A1 CLR D7 MOVW @A1,D7 ; get offset to end BEQ 140$ ; null is end of table MOV A1,A2 ADDW (A1)+,A2 ; A2 indexs the address field ADD #2,A2 ; A2 now indexs the next entry ADD #1,A1 ; ignore size byte CALL PTRTYP ; type command name TSTB @A1 BNE 120$ ADD #1,A1 120$: TAB CALL PTRTYP ; type the help text CRLF BR 110$ 140$: CRLF CRLF RTN ; S H O W - Show user the current optional settings. SHOW: LEA A1,ATERM(A0) ; index trmdef name BNE 2$ TYPE <NO REMOTE TRMDEF assigned> BR 3$ 2$: TYPE <Remote TRMDEF is named > TTYL @A1 3$: CRLF CALL SHOESC TYPE <Bell is > TSTB DING(A0) BEQ 4$ TYPECR <ON.> BR 10$ 4$: TYPECR <OFF.> 10$: TSTB DUPLEX(A0) BNE 20$ TYPE <Full> BR 30$ 20$: TYPE <Half> 30$: TYPE < Duplex Debug > TSTB DEBUGO(A0) BNE 40$ TYPECR <Off> BR 50$ 40$: TYPECR <On> 50$: TYPE <Maximum packet size = > CLR D1 MOVB SPSIZ(A0),D1 ; get packet size DCVT 0,2 CRLF TYPE <Delay interval = > MOV TIMINT(A0),D1 ; default to 1 char checksum DCVT 0,2 TYPE < Maximum attempts per packet is > CLR D1 MOVB MAXTRY(A0),D1 DCVT 0,2 CRLF TYPE <Pad character is > MOVB PADCHR(A0),D1 ; default to 1 char checksum CALL SHOCHR TAB TYPE <Pad count = > MOVB PAD(A0),D1 ; default to 1 char checksum DCVT 0,2 CRLF TYPE <Current end of packet byte is > MOVB EOL(A0),D1 ; set end of line char CALL SHOCHR TYPE < , default is > MOVB DF.EOL(A0),D1 CALL SHOCHR CRLF TYPE <Current control quote is > MOVB QUOTE(A0),D1 ; set control-quote. CALL SHOCHR TAB ; check 8-bit quote status TYPE <Default 8-bit quote=> MOVB DF.QBN(A0),D1 CALL SHOCHR TYPE <8-bit status: > MOVB QBIN(A0),D1 ; get QBIN BEQ 60$ ; 8bit is transmitted intact BMI 70$ ; no 8 bit quoting allowed TYPE <8-bit quote = > TTY BR 80$ 60$: TYPE <Remote is capable of 8 bit transfers> BR 80$ 70$: TYPE <Remote can not transfer binary files> 80$: TYPECR <.> TYPE <Default check type is > MOVB DF.CHK(A0),D1 TTY TYPE <, check type in use is > MOVB CHKT(A0),D1 ; default to 1 char checksum TTY CRLF RTN ; S E T - allow user to change some parameters. ; SET command accepts a sub-command (or argument) to define the action. ; If no sub-command is given, a short expansion of the subcommands is given. SET: BYP LIN ; end of line? BEQ 100$ ; yes-show user what can be set. LEA A1,SETCOM ; index set command list CALL COMAND ; see if we have an argument BNE 10$ ; no-show user no can do. ; perform the desired function. Each function does its own error-checking. CALL PROCES ; do the set RTN 10$: TYPE<? > ; no match - show user bad news. 15$: LIN ; end of line? BEQ 20$ ; yes-done typing user's entry MOVB (A2)+,D1 TTY ; type a character BR 15$ ; until the end of line 20$: TYPECR <? - undefined command.> 25$: RTN ; Show explanation for all set commands 100$: TTYL SET1 LEA A2,SETCOM ; index table 110$: MOV A2,A1 CLR D7 MOVW @A1,D7 ; get offset to end BEQ 140$ ; null is end of table MOV A1,A2 ADDW (A1)+,A2 ; A2 indexs the address field ADD #2,A2 ; A2 now indexs the next entry ADD #1,A1 ; ignore size byte CALL PTRTYP ; type command name TSTB @A1 BNE 120$ ADD #1,A1 120$: TAB CALL PTRTYP ; type the help text CRLF BR 110$ 140$: CRLF CRLF RTN ;; S E T S U B C O M M A N D S ; B E L L - set bell after each command completeion flag. BELL: LEA A1,ONOFF ; index option list CALL GETOPT ; process option BNE 10$ ; no good MOVB D1,DING(A0) ; set bell option 10$: RTN ; D U P L E X - set half or full duplex. DUPLEX: LEA A1,EPLEX ; index echoplex options CALL GETOPT ; process option BNE 10$ ; no good MOVB D1,ECHO(A0) ; set bell option 10$: RTN ; B L O C K - set default check type. 1 or 2 byte checksum BLOCK: LEA A1,ONETWO ; index check-type options CALL GETOPT BNE 10$ ; no good MOVB D1,DF.CHK(A0) ; set default check type 10$: RTN ; D E B U G - Set debug message print flag. DEBUG: LEA A1,ONOFF ; allow YES or NO. CALL GETOPT BNE 10$ MOVB D1,DEBUGO(A0) ; set debug option 10$: RTN ; E N D L I N - set optional end of packet character. (normally CR.) ENDLIN: CALL EVLCHR ; get the character BNE 10$ MOVB D1,DF.EOL(A0) ; set default EOL 10$: RTN ; E S C A P E - set the escape from CONNECT mode character. ESCAPE: CALL EVLCHR BNE 10$ ; no good MOVB D1,KMETA(A0) ; set escape character 10$: RTN ; T I M E R - set the timeout period used in packet transmission. TIMER: BYP GTDEC ; get decimal number CMP D1,#MINTIM ; compare to minimum time BHIS 10$ ; allow 2 or more MOV #MINTIM,D1 ; force minimum 10$: MOV D1,TIMINT(A0) ; set time interval period RTN ; N E W T R Y - sets the maximum # of tries for a packet. NEWTRY: BYP GTDEC TST D1 ; test new value BEQ 20$ ; zero is too few! CMP D1,#255 ; this is max BHI 20$ ; too high-leave as is MOVB D1,MAXTRY(A0) ; set max value RTN 20$: TTYI ASCII /?value out of range?/ BYTE 7,15,0 EVEN RTN ; B Q U O T E - set the binary quote type BQUOTE: CALL EVLCHR ; get the character BNE 10$ MOVB D1,DF.QBN(A0) ; set default EOL 10$: RTN ; G E T O P T - compares the input option @A2 to the option list @A1. ; If there is a match, the match number is returned in D1 and Z is set. ; No match returns Z clear and displays the error message at the end of the ; option list. GETOPT: SUB #2,A1 ; adjustment for first entry BYP ; scan past seperators PUSH A2 ; save string address for compares ; calculate address of next entry and place in A1. OPT.1: MOV @SP,A2 ; restore string pointer LEA A3,2(A1) ; A3 indexs next entry TSTW @A3 ; end of table ? BEQ OPT.5 ; yes-no match. MOV A3,A1 ; no-get address of command size word ADDW (A3)+,A1 ; and index to next command. CLR D5 MOVB (A3)+,D5 ; D5 gets qualifier size in bytes OPT.2: TRM ; check for end of word BEQ OPT.4 ; yes-check match count TSTB @A3 ; check for end of table entry BEQ OPT.1 ; must be wrong if so. OPT.3: MOVB @A2,D1 UCS ; convert to upper case CMPB D1,(A3)+ ; compare strings BNE OPT.4 ; until no match ADD #1,A2 ; advance A2 TST D5 ; check for minimum match length BEQ OPT.2 ; made it-stop counting SUB #1,D5 ; decrement byte count BR OPT.2 ; keep testing till line is terminated OPT.4: TST D5 ; good match has zero count BNE OPT.1 ; no good-try next TRM ; good match has no more data BNE OPT.1 POP ; toss old A2 CLR D1 MOVB @A1,D1 ; D1 gets argument value LCC #PS.Z ; flag command match found RTN ; undefined command - Clear Z flag OPT.5: POP A2 TTYL 2(A3) ; display error message at end of list LCC #0 RTN ; return with Z clear ; P T R T Y P - print the string indexed by A1 until a null is found. PTRTYP: MOVB (A1)+,D1 BEQ 10$ TTY BR PTRTYP 10$: RTN ; G O O D B Y - exit from KERMIT to AMOS for good. ; re-attach comm TRMDEF to its former job, if any. GOODBY: ANDW #^C<FIL!LOK>,-10(A0) ; clear file and locked in mem flags JOBIDX A6 MOVW SAVJTP(A0),JOBTYP(A6) ; save job type word MOV REMOTE(A0),A5 MOV #^C<REMMOD!T$ASN>,D1 ; clear all bits EXCEPT OIP CALL SETSTS CLR D1 MOVW SAVSTS(A0),D1 ; get saved status AND #^CT$OIP,D1 ; less OIP bit which hangs output! CALL SETSTS ; set the saved bits MOV SAVJCB(A0),A6 MOV A6,T.JLK(A5) ; restore any attached job BEQ 10$ MOV A5,JOBTRM(A6) ; and JCB, if there was one 10$: MOV SAVTDV(A0),T.TDV(A5) ; restore TDV SETB DONE(A0) ; set the we are done flag RTN ; A M O S - move to AMOS level temporarily. AMOS: SETB DONE(A0) ; set the we are done flag RTN ; S E T S T S ; This routine sets or clears status bits in D1. ; If D1 is minus, the bits are cleared. If they are +, the bits are set ; This routine works by using the breakpoint feature of the 68000, to ; avoid using the vaporware SUPVR call, which alpha warns may disappear ; any day now. ; This routine is used to set and reset TRMSER status word bits without ; getting T$OIP fouled up and hanging the job's output. SETSTS: SAVE A3,A4 ; get some work regs JOBIDX A3 ; index our JCB PUSH JOBBPT(A3) ; save any pending BPT vector LEA A4,SETBIT ; index the bit fiddling routine. MOV A4,JOBBPT(A3) ; make it our breakpoint routine. BPT ; execute this POP JOBBPT(A3) ; restore old breakpoint REST A3,A4 ; and workspace regs RTN ; done. ; This routine is called as a breakpoint routine, and runs in SUPVR mode ; Used to change TRMSER status bits. SETBIT: SVLOK ; prevent interrupts TSTW D1 ; set or clear bits? BMI 10$ ; clear is negative ORW D1,@A5 ; set bits if + or 0. BR 20$ ; done setting... 10$: ANDW D1,@A5 ; clear those bits 20$: SVUNLK ; allow other processes RTE ; done with this exceptional routine. ;;; F I L E T R A N S F E R R O U T I N E S ; S E N D S W ; SENDSW is the state table switch for file transfers. It loops either ; until it finishes, or an error is encountered. The routines called ; by SENDSW change the automaton state. SENDSW: MOVB #'S,STATE(A0) ; start with SEND INIT CLRB N(A0) ; clear the seq number CLRB NUMTRY(A0) ; and the retry count CLRB LOGIC(A0) ; CLEAR LOGIC 10$: TSTB LOGIC(A0) ; test logic flag BNE 100$ ; we are done CTRLC ABORT ; exit on control-C TSTB DEBUGO(A0) ; debug on ? BEQ 20$ ; no TYPE <SENDSW state > MOVB STATE(A0),D1 TTY CRLF CRLF 20$: LEA A6,SWSTAT-4 ; index the state table MOVB STATE(A0),D7 ; D7 gets the current state 30$: ADD #4,A6 ; pre-advance MOVB @A6,D6 BEQ 100$ ; undefined state - so exit CMPB D6,D7 ; matching state ? BNE 30$ ; no ADD #2,A6 ; yes - advance to offset ADDW @A6,A6 ; calc address of new routine CALL @A6 ; execute it BR 10$ ; loop till we exit 100$: RTN ABORT: MOVB #'A,STATE(A0) ; flag it as bad. MOVB #FALSE,LOGIC(A0) RTN COMPLT: MOVB #TRUE,LOGIC(A0) ; flag complete o.k. RTN ; S I N I T ; Send (I) Initiate Packet & receive REMOTEs reply SINIT: ADDB #1,NUMTRY(A0) ; bump # of tries CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max? BNE 20$ MOVB #'A,STATE(A0) RTN 20$: LEA A3,PACKET(A0) ; index the packet area CALL SPAR ; load default data for S packet CALL FLUSH ; flush pending input MOVB DF.EOL(A0),EOL(A0) ; use default EOL SPACK #'S,N(A0),#PARSIZ,PACKET(A0) ; send an S packet ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,RECPKT(A0),D4 ; receive a packet BNE 1000$ ; no packet received ; timeout ; or damaged packet CMPB D4,#'N ; NAK, try again JEQ 1000$ ; just return, leave state as is. CMPB D4,#'Y ; ACK ? BNE 30$ ; no ACK CMPB D3,N(A0) ; yes-same # as I sent? BNE 1000$ ; no-return, same state ; get other side's init info. LEA A3,RECPKT(A0) ; index work area CALL RPAR ; load parameters from work area CMPB QUOTE(A0),#SPACE ; check for space or null BHI 32$ MOVB #MYQUOT,QUOTE(A0) ; reset to # 32$: CLRB NUMTRY(A0) ; clear retries CALL BUMPP ; bump N mod 64. MOVB #'F,STATE(A0) ; move to state F JMP 1000$ ; done 30$: CMPB D4,#'E ; error packet received ? BNE 40$ ; no CALL PRTERR ; show error ; move to abort state on any undefined TYPEs 40$: MOVB #'A,STATE(A0) ; move to abort state. 1000$: RTN ; S F I L E sends the file header. SFILE: INCB NUMTRY(A0) ; bump the count CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max? BLOS 10$ ; no MOVB #'A,STATE(A0) ; set state to abort RTN 10$: CLR D2 MOVB FLLEN(A0),D2 ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'F,N(A0),D2,NFILNM(A0) ; send the F packet ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,RECPKT(A0),D4 ; wait for reply BNE 1000$ ; no reply ; compare received sequence # to expected # CMPB D4,#'N ; NAK ? BNE 30$ ; no NAK here MOVB N(A0),D1 CALL PREVP ; D1 gets previous packet # CMPB D1,D3 ; NAK for next block ? BNE 1000$ ; no-return with state unchanged BR 35$ ; yes-treat as ACK for this block 30$: CMPB D4,#'Y ; ACK ? BNE 40$ ; no MOVB N(A0),D1 ; D1 gets current SEQ # CMPB D3,D1 ; yes-is it expected SEQ? BNE 1000$ ; no-return state unchanged 35$: CLRB NUMTRY(A0) ; yes-clear retries count CALL BUMPP LEA A3,PACKET(A0) CALL BUFFIL ; fill a buffer @A3 MOVB #'D,STATE(A0) ; goto Data state JMP 1000$ 40$: CMPB D4,#'E ; Error packet received BNE 50$ CALL PRTERR ; show the error ; if any other case, move to abort case 50$: MOVB #'A,STATE(A0) ; move to abort state 1000$: RTN ; S D A T A - sends file data. (e.g. filename.) SDATA: INCB NUMTRY(A0) ; bump try count CMMB NUMTRY(A0),MAXTRY(A0) ; maxxed out ? BLOS 10$ ; no MOVB #'A,STATE(A0) ; yes-move to abort state RTN 10$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'D,N(A0),BUFCNT(A0),PACKET(A0) ; send data packet ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,RECPKT(A0),D4 ; receive a packet BNE 1000$ ; no data received CMPB D4,#'N ; NAK ? BNE 20$ ; no CALL NEXTN ; D1 gets N CMPB D1,D3 ; NAK for N+1? BEQ 30$ ; yes-treat as lost ACK for N JMP 1000$ ; else exit state unchanged 20$: CMPB D4,#'Y ; ACK ? BNE 50$ ; no CMPB D3,N(A0) ; right SEQ of ACK? BNE 1000$ ; no-state unchanged 30$: CALL BUMPP ; bump packet count CLRB NUMTRY(A0) ; clear the try count LEA A3,PACKET(A0) ; index the Packet CALL BUFFIL ; get a buffer TSTB BUFCNT(A0) ; any data to send ? BNE 40$ MOVB #'Z,STATE(A0) ; move to Z state (end of file) JMP 1000$ 40$: MOVB #'D,STATE(A0) ; stay in D state JMP 1000$ 50$: CMPB D4,#'E ; Error packet ? BNE 1000$ CALL PRTERR MOVB #'A,STATE(A0) ; move to A state. 1000$: RTN ; S E O F - send the end of file packet. SEOF: INCB NUMTRY(A0) CMMB NUMTRY(A0),MAXTRY(A0) BLOS 10$ MOVB #'A,STATE(A0) RTN 10$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Z,N(A0),#0,PACKET(A0) ; send a Z packet ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,RECPKT(A0),D4 ; get a reply BNE 1000$ ; CMPB D4,#'N ; NAK ? BNE 20$ CALL NEXTN ; D1 gets next N mod 64. CMPB D1,D3 ; NAK for SEQ+1? BEQ 30$ ; yes-treat as ACK. JMP 1000$ ; return as is 20$: CMPB D4,#'Y ; ACK ? BNE 40$ ; no CMPB D3,N(A0) ; matching SEQ #? BNE 1000$ ; no-return as is 30$: CALL BUMPP ; bump the N value ; add check for multiple files here when we get some "free time"! MOVB #'B,STATE(A0) ; goto Break state JMP 1000$ 40$: CMPB D4,#'E ; error packet ? BNE 50$ ; no CALL PRTERR ; yes-print erorrrr. JMP 1000$ 50$: MOVB #'A,STATE(A0) ; abort on undefined types 1000$: RTN ; S B R E A K - sends a break frame. SBREAK: INCB NUMTRY(A0) ; bump the try count CMMB NUMTRY(A0),MAXTRY(A0) ; maxxed out? BLOS 10$ ; no MOVB #'A,STATE(A0) ; yes-abort state RTN 10$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'B,N(A0),#0,PACKET(A0) ; send a B packet ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,RECPKT(A0),D4 ; get a reply BNE 1000$ ; no reply CMPB D4,#'N ; NAK ? BNE 20$ CALL NEXTN ; D1 gets next N mod 64. CMPB D1,D3 ; NAK for SEQ+1? BEQ 30$ ; yes-treat as ACK. JMP 1000$ ; return as is 20$: CMPB D4,#'Y ; ACK ? BNE 40$ ; no CMPB D3,N(A0) ; matching SEQ #? BNE 1000$ ; no-return as is 30$: CALL BUMPP ; bump the N value ; add check for multiple files here when we get some "free time"! MOVB #'C,STATE(A0) ; goto Complete state JMP 1000$ 40$: CMPB D4,#'E ; error packet ? BNE 50$ ; no CALL PRTERR ; yes-print erorrrr. JMP 1000$ 50$: MOVB #'A,STATE(A0) ; abort on undefined types 1000$: RTN ; R E C S W - is the state table switch for receiving files. RECSW: MOVB #'R,STATE(A0) ; start with RECV INIT state CLRB N(A0) ; clear the seq number CLRB NUMTRY(A0) ; and the retry count CLRB LOGIC(A0) ; clear logic 10$: TSTB LOGIC(A0) ; test logic flag BNE 100$ ; we are done CTRLC RABOR ; or user wants out TSTB DEBUGO(A0) ; debug on ? BEQ 20$ ; no TYPE <RECSW state > MOVB STATE(A0),D1 TTY CRLF CRLF 20$: LEA A6,RCSTAT-4 ; index the state table MOVB STATE(A0),D7 ; D7 gets the current state 30$: ADD #4,A6 ; pre-advance MOVB @A6,D6 BEQ 100$ ; undefined state - so exit CMPB D6,D7 ; matching state ? BNE 30$ ; no ADD #2,A6 ; yes - advance to offset ADDW @A6,A6 ; calc address of new routine CALL @A6 ; execute it BR 10$ ; loop till we exit 100$: RTN RABOR: MOVB #'A,STATE(A0) ; flag transfer as bad MOVB #FALSE,LOGIC(A0) RTN RCOMP: MOVB #TRUE,LOGIC(A0) ; flag complete o.k. RTN ; R I N I T - is the receive init routine RINIT: ADDB #1,NUMTRY(A0) ; count the tries CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max? BNE 20$ MOVB #'A,STATE(A0) RTN 20$: ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,PACKET(A0),D4 ; receive a packet BNE 50$ ; no packet received ; timeout CMPB D4,#'S ; got an S packet ? BNE 30$ ; no S packet ; get other side's init data LEA A3,PACKET(A0) ; index data packet address CALL RPAR ; get parameters LEA A3,PACKET(A0) ; index data packet address CALL SPAR ; send our parameters ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,N(A0),#PARSIZ,PACKET(A0); send ACK with reply MOVB NUMTRY(A0),OLDTRY(A0) ; save try count CLRB NUMTRY(A0) ; clear count CALL BUMPP ; bump packet # MOVB #'F,STATE(A0) ; bump state JMP 1000$ ; end 30$: CMPB D4,#'E ; error received ? BNE 40$ CALL PRTERR ; display the error. MOVB #'A,STATE(A0) JMP 1000$ ; done ; all others default to A state 40$: MOVB #'A,STATE(A0) ; received junk-abort JMP 1000$ ; no packet received - send a NAK 50$: SPACK #'N,N(A0),#0,NFILNM(A0) ; send a NAK packet ; return without state change 1000$: RTN ; R F I L E - receive a file header frame with the filename. RFILE: ADDB #1,NUMTRY(A0) ; count the tries CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max? BNE 20$ MOVB #'A,STATE(A0) RTN 20$: ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,NFILNM(A0),D4 ; receive a packet (expecting filename) JNE 500$ ; no packet received ; timeout CMPB D4,#'S ; got an S packet ? BNE 50$ ; no ; SEND-INIT received, maybe ACK was lost. CALL NEXTO ; D1 gets next OLDTRY value CMPB D1,MAXTRY(A0) ; time to give up? BLOS 30$ ; no MOVB #'A,STATE(A0) JMP 1000$ ; yes-goto abort state. 30$: MOVB N(A0),D1 ; D1 gets current packet # CALL PREVP ; get previous packet # CMPB D1,D3 ; previous packet ? BNE 40$ ; no ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,D3,#PARSIZ,PACKET(A0) ; yes-ack again with SEND-INIT CLRB NUMTRY(A0) ; clear retry count JMP 1000$ ; stay in state. 40$: MOVB #'A,STATE(A0) ; goto abort JMP 1000$ ; done 50$: CMPB D4,#'Z ; end of file? BNE 80$ ; no CALL NEXTO ; D1 gets next oldtry CMPB D1,MAXTRY(A0) ; time to give up? BLOS 60$ ; no MOVB #'A,STATE(A0) ; yes-abort JMP 1000$ ; done 60$: MOVB N(A0),D1 ; get N CALL PREVP ; calc previous packet # to D1 CMPB D1,D3 ; same ? BNE 70$ ; no ; SPACK TYPE,SEQ,SIZE,PACKET ; perhaps this should not be PACKET, but some other area!!!! SPACK #'Y,D3,#0,PACKET(A0) ; yes-ack again with SEND-INIT CLRB NUMTRY(A0) ; reset tries JMP 1000$ ; done 70$: MOVB #'A,STATE(A0) ; goto ABORT otherwise. JMP 1000$ 80$: CMPB D4,#'F ; is the the blessed file header yet? JNE 200$ ; no CMPB D3,N(A0) ; yes-is the packet # correct? BNE 70$ ; no-move to abort state. CALL RFILNM ; process the filename & open. BEQ 90$ ; it opened ok CALL LFERR ; show local file error MOVB #'A,STATE(A0) ; move to abort state JMP 1000$ ; done 90$: TSTB NOTALK(A0) ; do we have a user terminal? BNE 120$ ; no-bypass message TYPE <Receiving > CLR D0 MOVB LDATA(A0),D0 LEA A1,FILNAM(A0) BR 110$ 100$: MOVB (A1)+,D1 TTY 110$: DBF D0,100$ TYPE < as > PFILE FIO(A0) CRLF 120$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,N(A0),#0,PACKET(A0) ; send ACK for the F packet MOVB NUMTRY(A0),OLDTRY(A0) ; reset try counters CLRB NUMTRY(A0) CALL BUMPP ; get next packet # MOVB #'D,STATE(A0) ; move to data state JMP 1000$ 200$: CMPB D4,#'B ; break ? BNE 300$ ; no CMPB D3,N(A0) ; yes-is packet # correct? BNE 310$ ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,N(A0),#0,PACKET(A0) ; send ACK for the B packet MOVB #'C,STATE(A0) ; and move to Complete state JMP 1000$ ; end 300$: CMPB D4,#'E ; error frame ? BNE 400$ ; no CALL PRTERR ; show it 310$: MOVB #'A,STATE(A0) ; move to abort JMP 1000$ 400$: MOVB #'A,STATE(A0) ; goto abort state JMP 1000$ ; didnt get a packet 500$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'N,N(A0),#0,PACKET(A0) ; send NAK 1000$: RTN ; R D A T A - receives the data packets that make up the file. RDATA: ADDB #1,NUMTRY(A0) ; count the tries CMMB NUMTRY(A0),MAXTRY(A0) ; beyond the max? BNE 20$ MOVB #'A,STATE(A0) RTN 20$: ; RPACK LEN,SEQ,PACKET,TYPE RPACK D2,D3,PACKET(A0),D4 ; receive a packet (expecting filename) JNE 500$ ; no packet received ; timeout CMPB D4,#'D ; got a Data packet ? JNE 60$ ; no CMPB D3,N(A0) ; yes-is it right packet # ? BEQ 50$ ; YES CALL NEXTO ; NO-get next OLDTRY value in D1 CMPB D1,MAXTRY(A0) ; BLOS 25$ MOVB #'A,STATE(A0) ; abort -retries exceeded JMP 1000$ ; done 25$: MOVB N(A0),D1 ; D1 gets current packet # CALL PREVP ; get previous packet # CMPB D1,D3 ; previous packet ? BNE 40$ ; no ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,D3,#6,PACKET(A0) ; yes-re-ack. CLRB NUMTRY(A0) ; clear retry count JMP 1000$ ; stay in state. 40$: MOVB #'A,STATE(A0) ; goto abort JMP 1000$ ; done ; received valid data frame - output it 50$: CALL BUFEMP ; empty the buffer to disk ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,N(A0),#0,PACKET(A0) ; ack the data MOVB NUMTRY(A0),OLDTRY(A0) ; reset the try counters CLRB NUMTRY(A0) ; clear retry count CALL BUMPP ; bump the packet # MOVB #'D,STATE(A0) ; stick in D state. JMP 1000$ ; stay in state. 60$: CMPB D4,#'F ; file header? BNE 80$ ; no CALL NEXTO ; D1 gets next oldtry CMPB D1,MAXTRY(A0) ; time to give up? BLOS 70$ ; no 65$: MOVB #'A,STATE(A0) ; yes-abort JMP 1000$ ; done 70$: MOVB N(A0),D1 ; get N CALL PREVP ; calc previous packet # to D1 CMPB D1,D3 ; same ? BNE 65$ ; no ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,D3,#0,PACKET(A0) ; yes-ack again CLRB NUMTRY(A0) ; reset tries JMP 1000$ ; done 80$: CMPB D4,#'Z ; end of file? BNE 200$ ; no CMPB D3,N(A0) ; yes-is the packet # correct? BNE 65$ ; no-move to abort state. ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'Y,D3,#0,PACKET(A0) ; ack the Z CLOSE FIO(A0) ; yes-close the file CALL BUMPP ; bumpthepacket# MOVB #'F,STATE(A0) ; return the F state BR 1000$ 200$: CMPB D4,#'E ; error frame ? BNE 400$ ; no CALL PRTERR ; show it MOVB #'A,STATE(A0) ; move to abort JMP 1000$ 400$: MOVB #'A,STATE(A0) ; goto abort state JMP 1000$ ; didnt get a packet 500$: ; SPACK TYPE,SEQ,SIZE,PACKET SPACK #'N,N(A0),#0,PACKET(A0) ; send NAK 1000$: RTN ;;; P A C K E T U T I L I T I E S ; B U M P P - bumps the current packet mod 64. The new N is returned in D1, ; and is also updated in N(A0). BUMPP: BCALL NEXTN MOVB D1,N(A0) RTN ; N E X T N - returns the next N(A0) value in D1. It does NOT update N(A0). NEXTN: MOVB N(A0),D1 ADD #1,D1 AND #63.,D1 RTN ; N E X T O - returns the next OLDTRY(A0) value in D1. It does not update OLDTRY(A0). NEXTO: MOVB OLDTRY(A0),D1 ADD #1,D1 AND #63.,D1 RTN ; P R E V P - returns the prior packet to D1 in D1. ( D1-1 mod 64. ) PREVP: SUB #1,D1 AND #63.,D1 RTN ; P R T E R R - prints the error message contained in the Error packet PRTERR: CLR D0 ; MOVB LDATA(A0),D0 ; get length of data field LEA A1,DATA(A3) TTYL ABTTTL BR 30$ 20$: MOVB (A1)+,D1 TTY 30$: DBF D0,20$ CRLF RTN ; S P A R - fill data area with send-init parameters SPAR: LEA A1,DATA(A3) ; index payload area CLR D1 MOV #PAKSIZ,D1 ; get max packet size CHAR D1 MOVB D1,(A1)+ ; 1 max packet size MOV TIMINT(A0),D1 CHAR D1 MOVB D1,(A1)+ ; 2 # of seconds to my timeout MOV #MYPAD,D1 CHAR D1 MOVB D1,(A1)+ ; 3 # of padding characters MOV #MYPCHR,D1 CTL D1 ; the pad character translated MOVB D1,(A1)+ ; 4 MOV #0,D1 ; we do not need an EOL this end. CHAR D1 MOVB D1,(A1)+ ; 5 end of line character MOV #MYQUOT,D1 MOVB D1,(A1)+ ; 6 control quoting character MOVB DF.QBN(A0),(A1)+ ; 7 the optional binary quoter MOVB DF.CHK(A0),(A1)+ ; 8 the optional checksum type PARSIZ =8. ;;; MOVB #'~,(A1)+ ; 9 repeat prefix (~) RTN ; R P A R - get the REMOTE's send-init parameters. ; At entry, A3 indexs the packet area RPAR: MOVB #'1,CHKT(A0) ; default to 1 char checksum MOVB #SPACE,REPT(A0) ; and no repeat LEA A1,DATA(A3) ; index the payload area CLR D1 MOVB (A1)+,D1 ; get MAXL byte UNCHAR D1 CMPB D1,#96. ; WITHIN REASON ? BHI 7$ ; no CMPB D1,#40. ; WITHIN REASON ? BHIS 8$ 7$: MOV #96.,D1 8$: MOVB D1,SPSIZ(A0) ; set send packet size MOVB (A1)+,D1 ; get TIME byte UNCHAR D1 MOV D1,TIMINT(A0) ; set when I should time out MOVB (A1)+,D1 ; get NPAD byte UNCHAR D1 MOVB D1,PAD(A0) ; set pad count. MOVB (A1)+,D1 ; get PADC byte CTL D1 MOVB D1,PADCHR(A0) ; set pad character MOVB (A1)+,D1 ; get EOL byte UNCHAR D1 MOVB D1,EOL(A0) ; set end of line char MOVB (A1)+,D1 ; get QCTL byte CMPB D1,#SPACE BHI 9$ MOV #MYQUOT,D1 ; default it 9$: MOVB D1,QUOTE(A0) ; set control-quote. CLR D2 MOVB LDATA(A0),D2 ; get size of data area SUB #6,D2 ; have more than basic 6 bytes? BLOS 100$ ; no more data ; get QBIN MOVB (A1)+,D1 ; get QBIN byte AND #177,D1 ; strip to ASCII CMPB D1,#SPACE ; was it a space through null? BLOS 30$ ; yes-can not do 8bit! 10$: CMPB D1,#'Y ; will do it only if we request? BNE 20$ ; no CMPB D1,DF.QBN(A0) ; yes-izatok with user? BNE 40$ ; no-user does not want 8 bit CLR D1 ; yes-good! Null indicates 8 bits 20$: CMPB D1,#'N ; no to quoting? BNE 40$ ; no 30$: MOV #-1,D1 ; yes- D1 indicates no 8bit at all! 40$: MOVB D1,QBIN(A0) ; set QBIN SUB #1,D2 BEQ 100$ ; no more ; get CHKT MOVB (A1)+,D1 ; get CHKT byte CMPB D1,#'2 ; higher than 2? BHI 50$ ; yes-force to one BEQ 60$ ; no-exactly two-allow it CMPB D1,#1 ; do not allow zero BEQ 60$ 50$: MOV #'1,D1 ; force to 1 if not 1 or 2 60$: MOVB D1,CHKT(A0) ; set checksum method SUB #1,D2 BEQ 100$ ; get REPT MOVB (A1)+,D1 ; get REPT byte UNCHAR D1 MOVB D1,REPT(A0) ; set repeat prefix 100$: CMPB QUOTE(A0),#SPACE ; quote undefined ? BNE 110$ ; no-defined MOVB #'#,QUOTE(A0) ; yes-use default 110$: RTN ; FLUSH deletes all pending input from the input buffer FLUSH: MOV REMOTE(A0),A5 CLR T.ICC(A5) RTN ; B U F F I L - fills a packet @A3 with data. ; we will limit data size to 3 less than actual size to allow the last ; character to be control and 8bit quoted, without look-ahead schemes. ; the worst cases are '# = &## and '& = &#&. ; data count goes to BUFCNT(A0). ; At entry, A3 must index the data packet area to be filled, ; CHKNOW(A0) must contain the binary checksum size BUFFIL: CLR D0 MOVB SPSIZ(A0),D0 ; D0 gets max msg size to remote SUBB CHKNOW(A0),D0 ; less size of checksum SUB #<3>,D0 ; less overhead bytes LEA A1,DATA(A3) ; index the data area 10$: FILINB FIO(A0) ; get a data byte TST FIO+D.SIZ(A0) ; end of file ? BEQ 100$ ; yes ; test for high bit BTST #7,D1 ; no-test for eighth bit set. BEQ 30$ ; bit 7 is clear ; handle high bit prefixing, if any MOVB QBIN(A0),D7 ; get 8bit quote character. BMI 20$ ; no high bit can be used BEQ 30$ ; no 8 bit quoting needed! MOVB D7,(A1)+ ; buffer the 8bit quote SUB #1,D0 ; decrement the count 20$: AND #177,D1 ; strip to ascii 30$: MOVB D1,D2 AND #177,D2 ; D2 gets stripped version CMPB D2,#DEL ; is it a DEL BEQ 35$ ; this is non-printable. ; also prefix the prefix, and the high bit prefix with the prefix! CMPB D2,QUOTE(A0) ; is this character the prefix? BNE 32$ ; no MOVB D2,(A1)+ ; yes-prefix it with itself SUB #1,D0 32$: TSTB QBIN(A0) ; check 8 bit quoting BLE 34$ ; none CMPB D2,QBIN(A0) ; matching? BNE 34$ ; no- [10/23/84 rpr] MOVB QUOTE(A0),(A1)+ ; yes-quote it first SUB #1,D0 ; less one for quote 34$: CMPB D2,#SPACE ; is it control ? BHIS 50$ ; no-prinatble ; unctrol-ify the character, while preserving possible bit7. 35$: CTL D1 ; uncontrol-ify 40$: MOVB QUOTE(A0),(A1)+ SUB #1,D0 50$: MOVB D1,(A1)+ SUB #1,D0 BGT 10$ ; loop till filled up 100$: LEA A6,DATA(A3) MOV A1,D1 SUB A6,D1 ; D1 gets outgoing data size MOVB D1,BUFCNT(A0) ; set data count RTN ; B U F E M P - empties the incoming data contents of the packet @A3 to ; the FIO(A0) file. BUFEMP: LEA A1,DATA(A3) ; index the data area CLR D0 MOVB LDATA(A0),D0 ; D0 gets the count 10$: CALL GETBYT ; get an input byte [10/23/84] ; doing 8bit quoting? MOVB QBIN(A0),D2 ; get 8bit quote character BLE 100$ ; no binary quoting CMPB D2,D1 ; is it binary quote ? BNE 100$ ; no ; 8bit quote received. Evaluate following characters. MOV #200,D3 ; set high bit flag CALL GETBYT ; get next byte CALL EVALQ ; evaluate this & next chars ORB D3,D1 ; combine evaluated char & top bit BR 500$ 100$: CLR D3 ; clear high bit flag CALL EVALQ ; evaluate 500$: FILOTB FIO(A0) ; output the data byte TST D0 BGT 10$ ; output all bytes RTN ; E V A L Q - evaluates the byte in D1. Expands quoted control characters, ; quoted quotes, and eighth bit quotes and quoted eighth bit quotes. EVALQ: CMPB D1,QUOTE(A0) ; is it a quote ? BNE 100$ ; no-just return with value CALL GETBYT ; yes - get next byte MOVB D1,D7 AND #177,D7 ; get stripped version of character CMPB D7,QUOTE(A0) ; is it double qoute ? BEQ 100$ ; yes-pass it literally TSTB QBIN(A0) ; test for 8 bit quote active BLE 10$ ; no-sending binaries CMPB D1,QBIN(A0) ; 8bit quote prefixed by ctl quote? BEQ 100$ ; yes-use literally. 10$: CTL D1 ; turn it to control 100$: RTN ; G E T B Y T - gets the next data byte for BUFEMP. GETBYT: MOVB (A1)+,D1 ; get a byte TSTB QBIN(A0) ; allowing binaries? BEQ 10$ ; yes AND #177,D1 ; no-strip to seven 10$: SUB #1,D0 ; adjust count RTN ; R E C P A K - receives a data packet from the remote computer. ; This routine simply inputs a single packet, without performing ; packet checking or other details. ; On Entry, A3 indexs the packet destination ; On exit, D0 is the received checksum ; D1 is the calculated checksum ; D2 is the LEN ; D3 is the SEQ ; D4 is the TYPE ; Z is set if a packet is received ; CHKNOW(A0) contains binary 1,2, or 3 for checksum size RECPAK: ; initialize packet receiver CALL SETEND ; set timer ending time MOV REMOTE(A0),A5 ; index the remote TRMDEF 10$: CALL GETREM ; get remote character JNE 100$ ; timeout, no data ; syncronize the packet to the mark byte (usually ^A) AND #177,D1 ; strip parity here, always CMPB D1,RMARK(A0) ; start of packet ? BNE 10$ ; no-keep looking 20$: MOV A3,A1 ; use A1 as work register. MOVB D1,(A1)+ ; yes-store it ; get the length from the next byte CALL GETREM ; get LEN JNE 100$ ; timeout, no data CMPB D1,RMARK(A0) ; start of packet ? BEQ 20$ ; yes-resync. MOVB D1,(A1)+ ; else save the LEN MOVW D1,CSUM(A0) ; start checksum with LEN UNCHAR D1 ; convert to binary MOV D1,D2 ; save the LEN ; receive the SEQ byte 30$: CALL GETREM ; get SEQ JNE 100$ ; timeout, no data CMPB D1,RMARK(A0) ; start of packet ? BEQ 20$ ; yes-resync. MOVB D1,(A1)+ ; else save the SEQ ADDW D1,CSUM(A0) ; update checksum MOV D1,D3 UNCHAR D3 ; D3 is sequence # ; receive the TYPE byte CALL GETREM ; get TYPE JNE 100$ ; timeout, no data CMPB D1,RMARK(A0) ; start of packet ? BEQ 20$ ; yes-resync. MOVB D1,(A1)+ ; else save the TYPE ADDW D1,CSUM(A0) ; update checksum MOV D1,D4 ; D4 gets the type ; calc the data area size. MOV D2,D1 ; D1 gets the binary length CALL CALCHK ; calculate checksum size CLR D0 MOVB CHKNOW(A0),D0 ; get checksum size ADD #2,D0 ; D0 gets size of SEQ,TYPE SUB D0,D1 ; D1 gets size of data area MOVB D1,LDATA(A0) ; save length of data MOV D1,D0 ; D0 gets length CMPB D0,#94.-3. ; is it legal ? JHI 100$ ; no-crap out BR 45$ ; use DBF to control buffering of ; 0 or more characters. ; buffer the data bytes 40$: CALL GETREM ; get a byte JNE 100$ ; timeout CMPB D1,RMARK(A0) ; start of packet ? BEQ 20$ ; yes-resync. MOVB D1,(A1)+ ; store data ADDW D1,CSUM(A0) ; update checksum 45$: DBF D0,40$ ; gather packet. ; now get the checksum CALL GETREM ; get CHECK JNE 100$ ; timeout, no data CMPB D1,RMARK(A0) ; start of packet ? JEQ 20$ ; yes-resync. UNCHAR D1 ; convert CHECK MOV D1,D0 ; D0 gets checksum byte #1 CMPB CHKNOW(A0),#2 ; two character checksum? BNE 60$ ; no-leave CHECK type as normal CALL GETREM ; yes- get second byte UNCHAR D1 ; convert it LSL D0,#6. ; shift 1st byte to bits 11-6 ORW D1,D0 ; D0 gets bits 11-0 MOVW CSUM(A0),D1 ; D1 gets calculated csum ANDW #^B0000111111111111,D1 ; mask it to 12 bits only BR 90$ 60$: CLR D1 MOVB CSUM(A0),D1 ; get calculated sum MOV D1,D7 ; twice LSR D7,#6 ; move bits 7-6 to 1-0 AND #3,D7 ; toss all other bits ADD D7,D1 ; add to sum AND #77,D1 ; strip to 6 bits. 90$: TSTB DEBUGO(A0) ; debug mode ? JEQ 95$ ; no PUSH D1 CLR D1 TYPE <==Received Packet # > MOV D3,D1 DCVT 2,OT$TRM!OT$TSP ; output as 2 characters TYPE <, Type > MOV D4,D1 TTY TYPE < Length: > MOV D2,D1 DCVT 2,OT$TRM CRLF TYPE <Checksums > MOV @SP,D1 ; get calced sum CMPW D0,D1 ; do they match ? BNE 93$ ; no TYPE <match (> DCVT 0,2 TYPE <)> BR 94$ 93$: TYPE <calculated = > DCVT 0,2 TYPE <, received = > MOV D0,D1 DCVT 0,2 94$: CRLF CRLF POP D1 95$: CMPW D0,D1 ; compare checksums 100$: RTN ; S N D P A K - sends a packet. ; On Entry, A3 indexs the packet destination ; D2 is the LEN ; D3 is the SEQ ; D4 is the TYPE ; At exit, CHKNOW(A0) contains the checksum size used. SNDPAK: TSTB DEBUGO(A0) BEQ 30$ TYPE <Sending "> MOVB D4,D1 TTY TYPE <" packet # > CLR D1 MOVB D3,D1 DCVT 0,OT$TRM TYPE < of length > MOVB D2,D1 DCVT 0,OT$TRM CRLF TYPE <Data ="> SAVE A2,D0 LEA A2,DATA(A3) MOV D2,D0 SUB #1,D0 BMI 20$ 10$: MOVB (A2)+,D1 TTY DBF D0,10$ 20$: REST A2,D0 TYPECR <"> CRLF ; send a packet to the remote KERMIT 30$: MOV REMOTE(A0),A5 ; index remote TRMDEF CLR D0 MOVB PAD(A0),D0 ; get pad count BEQ 50$ ; no pad characters needed SUB #1,D0 ; adjust MOVB PADCHR(A0),D1 40$: TTYOUT ; send the pad character DBF D0,40$ ; 50$: MOV A3,A1 ; A1 is work pointer MOVB RMARK(A0),(A1)+ ; buffer MARK character MOV D2,D1 ; D1 gets LEN CALL CALCHK ; calculate checksum size ADDB CHKNOW(A0),D1 ; add size of checksum ADD #2,D1 ; plus SEQ & TYPE CHAR D1 ; make it printable MOVB D1,(A1)+ ; store LEN MOVW D1,CSUM(A0) ; initialize the checksum CHAR D3 MOVB D3,(A1)+ ; store SEQ ADDW D3,CSUM(A0) ; MOVB D4,(A1)+ ; store TYPE ADDW D4,CSUM(A0) ; ; data (if any) is already in buffer. Add it to checksum CLR D1 BR 70$ 60$: MOVB (A1)+,D1 ; get a byte ADDW D1,CSUM(A0) ; add to checksum 70$: DBF D2,60$ ; loop till all data checked ; handle checksum translation CMPB CHKNOW(A0),#2 ; two character checksum ? BNE 90$ ; no - must be one character ; two character checksum MOVW CSUM(A0),D1 ; get all bits MOV D1,D7 ; in two regs LSR D7,#6. ; position bits D11-D6 AND #77,D7 ; strip to 6 bits CHAR D7 ; make it printable MOVB D7,(A1)+ ; store D11-D6 AND #77,D1 ; strip to 6 bits CHAR D1 ; make it printable MOVB D1,(A1)+ ; store checksum bits D5-D0 BR 100$ 90$: MOVB CSUM(A0),D1 ; D1 gets low eight of sum MOV D1,D7 ; D7 gets same AND #300,D7 ; take just bits 7-6. LSR D7,#6. ; shift to bits 1-0 ADD D7,D1 ; D1 gets sum AND #63.,D1 ; make it six bits again. CHAR D1 ; make it prinatble MOVB D1,(A1)+ ; store checksum ; check for EOL character 100$: MOVB EOL(A0),D7 ; need any EOL ? BEQ 110$ ; no MOVB D7,(A1)+ ; yes-store it ; calculate size of buffered packet from pointer displacement 110$: MOV A1,D0 ; current position SUB A3,D0 ; less start is length SUB #1,D0 120$: MOVB (A3)+,D1 ; get a byte TTYOUT ; output it to REMOTE DBF D0,120$ ; till packet is sent RTN ; C A L C H K - determines the current checksum size. ; This routine unifies the logic needed to force 1 byte checksums on SEND-INIT ; fields and their ACKS. ; At entry, ; D2 contains the LEN in binary ; D4 contains the packet type ; At exit, CHKNOW(A0) contains the binary value of the current checksum size. CALCHK: CLR D7 MOVB CHKT(A0),D7 ; get checksum type SUBB #'0,D7 ; less ASCII bias ; force check type 1 for S packets CMPB D4,#'S ; Send Init ? BNE 10$ ; no MOV #1,D7 ; yes-force check 1 ; force check type 1 for Y responses to S packets. 10$: CMPB D4,#'Y ; ACK ? BNE 20$ ; no CMPB D2,#6 ; is it as big as a send-init ack? BLO 30$ ; no -it is not ACK to Send-Init MOV #1,D7 ; yes-force checksum type 1 BR 30$ 20$: 30$: MOVB D7,CHKNOW(A0) ; save current checksum choice RTN ; G E T R E M - gets a single character from the remote computer. ; At entry, A5 must index the REMOTE TRMDEF. ; At exit, D1 will contain the character, or a -1 for no character. ; Z will be set if a character was available for input. GETREM: MOV #-1,D1 ; preset for no data BR 20$ 10$: SLEEP #1000. ; wait .1 seconds for more data CTRLC 100$ GTIMEI D7 CMP D7,RTOUT(A0) ; EXPIRED? BHIS 200$ ; YES 20$: TST T.ICC(A5) ; any data to input ? BEQ 10$ ; no input CLR D1 ; pre-clear D1 TTYIN ; get a character TSTB QBIN(A0) ; are we allowing 8 data bits? BEQ 30$ ; yes AND #177,D1 ; no-strip parity bit 30$: CMPB D1,#3. ; control-c? BNE 40$ ; no COMB CCOUNT(A0) ; yes-toggle /2 counter BNE 50$ ; only one detected JOBIDX ORW #J.CCC,@A6 ; two detected - set control-c flag 40$: CLRB CCOUNT(A0) ; clear control-c count 50$: LCC #PS.Z RTN 100$: LCC #0 RTN 200$: LCC #PS.V ; flag overflow for timeout RTN ; S E T E N D - calculates and stores the value of the timeout point in internal ; format. SETEND: GTIMEI D7 ; D6 gets internal format time. ADD TIMINT(A0),D7 MOV #24.*60.*60.,D6 ; D6 gets highest internal time+1 CMP D7,D6 BLO 10$ ; o.k. - no wraparound SUB D6,D7 ; handle wrap-around 10$: MOV D7,RTOUT(A0) ; SET TIME-OUT TIME RTN ; G T S I Z E - gets file size in bytes. Destroys D6,D7. Assumes file ; has been looked up on FIO(A0). FSIZE(A0) contains the size on exit. GTSIZE: MOV FIO+D.SIZ(A0),D7 ; D7 gets record size MOV FIO+D.LEN(A0),D6 ; D6 gets # of blocks TSTW FIO+D.ACT+2(A0) ; random file ? BMI 10$ ; yep-straight multiply SUB #2,D7 ; no-subtract pointer bytes. SUB #1,D6 ; and less last block 10$: MUL D7,D6 ; block payload size * blocks TSTW FIO+D.ACT+2(A0) ; random file ? BMI 20$ ; yep. ADD FIO+D.ACT(A0),D7 ; sequential-add last block's count SUB #2,D7 ; less link word in last block 20$: MOV D7,FSIZE(A0) ; size of the file RTN ; S T A R T T - gets the current time and saves it in STIME(A0). ; Used to determine the elapsed time in file transfers. STARTT: GTIMEI STIME(A0) ; save the start time RTN ; E N D T M - calculate and display the elapsed time & effective baud rate ; for a file transfer. ; At entry, FSIZE must contain the file size in bytes. ENDTM: TSTB NOTALK(A0) ; do we have a user terminal? JNE 30$ GTIMEI D2 ; get current time SUB STIME(A0),D2 ; less start time BCC 10$ ; no midnight wraparound ADD #24.*60.*60,D2 ; else add 24 hours of seconds 10$: MOV D2,D4 ; save for effective baud rate TYPE <elapsed time was > CLR D1 DIV D2,#60.*60. ; convert to hours MOVW D2,D1 DCVT 2,OT$TRM!OT$ZER ; display hours TYPE : CLRW D2 SWAP D2 ; remainder to lower 16 bits DIV D2,#60. ; make it minutes MOVW D2,D1 DCVT 2,OT$TRM ; display minutes TYPE : CLRW D2 SWAP D2 ; seconds remiander to low 16 MOV D2,D1 DCVT 2,OT$TRM ; display seconds TYPE <, effective baud rate was > MOV FSIZE(A0),D1 ; get characters ; multiply by 10 by adding 2*D1 and 8*D1 MOV D1,D7 ; duplicate ADD D1,D1 ; double LSL D7,#3. ; shift to make 8* old D1 ADD D7,D1 ; add to make 10 * old D1 DIV D1,D4 ; divided by seconds AND #177777,D1 ; strip off remainder DCVT 0,2 ; display it TYPE <.> ; new line 30$: RTN ; S H O E S C displays the current escape from connect mode character. SHOESC: TYPE <Escape character is > MOVB KMETA(A0),D1 CALL SHOCHR CRLF RTN ; S H O C H R - displays in printable form the character in D1. SHOCHR: PUSH D1 BTST #7,D1 BEQ 10$ TYPE <%> 10$: AND #177,D1 CMPB D1,#SPACE BHIS 20$ TYPE ^ CTL D1 ; un-controlify it 20$: TTY POP D1 RTN IMPNAM: RAD50 /KERMITIMP/ ; name of user's variables module. ; This table defines the KERMIT commands and the subroutine address DEFINE KCOM NAME, KSIZE, ADDR, HELP WORD 10$$-. BYTE KSIZE ASCII /NAME/ BYTE 0 EVEN ASCII /HELP/ BYTE 0 EVEN 10$$: WORD ADDR-. ENDM ; K E R C O M is the main commands table for KERMIT. KERCOM: KCOM AMOS,1,AMOS,<Execute an AMOS command.> KCOM CONNECT,1,CONNEC,<Connects your terminal to the remote KERMIT site.> KCOM EXIT,1,GOODBY,<Exit from KERMIT to AMOS.> KCOM HELP,1,HELP,<Types a summary of KERMIT commands and what they do.> KCOM RECEIVE,1,RECEIV,<receive {filespec} receives a file from the remote KERMIT.> KCOM SEND,1,SEND,<{filename} sends a filename to the remote KERMIT.> KCOM SET,3,SET,<Set allows nonstandard parameters such as escape character.> KCOM SHOW,2,SHOW,<Show displays the current SET options.> KCOM ?,1,HELP,<The shorthand version of HELP.> WORD 0 ; S E T C O M is the SET subcommands table for SET. SETCOM: KCOM BELL,2,BELL,<Beep after each command option.> KCOM BINQUOTE,2,BQUOTE,<Set binary quoting default.> KCOM BLOCKCHECK,2,BLOCK,<Block-check type, 1 or 2 byte checksum.> KCOM DEBUG,2,DEBUG,<Debug option on or off.> KCOM DUPLEX,2,DUPLEX,<Set FULL or HALF duplex.> KCOM ENDLINE,2, ENDLIN,<Packet terminator character.> KCOM ESCAPE,2,ESCAPE,<Escape character for CONNECT.> KCOM RETRIES,1,NEWTRY,<Number of failed packet attempts that cause abort.> KCOM TIMEOUT,1,TIMER,<Packet time-out value.> WORD 0 ; This table defines the GETOPT list for options arguments. DEFINE OPT NAME, KSIZE, VALUE WORD 10$$-. BYTE KSIZE ASCII /NAME/ BYTE 0 EVEN 10$$: WORD VALUE ENDM ; This defines the format of the end of the options list. DEFINE OMSG STRING WORD 0 ASCII /STRING/ BYTE 0 ENDM ; options list for logical options (YES, NO, 1,0, TRUE, FALSE are valid) ONOFF: YESNO: OPT YES,1,377 OPT NO,1,0 OPT ON,2,377 OPT OFF,2,0 OPT TRUE,1,377 OPT FALSE,1,0 OPT 1,1,377 OPT 0,1,0 OMSG <%Use YES or NO, ON or OFF, TRUE or FALSE, 1 or 0.> EVEN ; options list for block check size ONETWO: OPT 1,1,'1 OPT 2,1,'2 OPT ONE,1,'1 OPT TWO,2,'2 OMSG <%Use 1, 2, ONE or TWO to set check value size.> EVEN ; options for echoplex (see DUPLEX:) EPLEX: OPT FULL,1,0 OPT HALF,1,377 OMSG <%Use FULL or HALF to set duplex options.> EVEN ; S W C A S E - macro to define the switcher state table DEFINE SWCASE STATE, ROUTE BYTE STATE EVEN OFFSET ROUTE ENDM ; S W S T A T is the table of valid SEND FILE states for KERMIT, ; and the offsets to the corresponding next routines. SWSTAT: SWCASE 'S,SINIT SWCASE 'F,SFILE SWCASE 'D,SDATA SWCASE 'Z,SEOF SWCASE 'B,SBREAK SWCASE 'C,COMPLT SWCASE 'A,ABORT BYTE 0 EVEN ; R C S T A T is the table of valid RECEIVE FILE states for KERMIT, ; and the offsets to the corresponding next routines. RCSTAT: SWCASE 'R,RINIT ; receive init SWCASE 'F,RFILE ; receive file SWCASE 'D,RDATA ; receive data SWCASE 'C,RCOMP ; receive complete SWCASE 'A,RABOR ; receieve abort BYTE 0 HLP1: ASCII / ========== Alpha-Kermit help ==========/ BYTE 15,15,0 ABTTTL: ASCII /KERMIT aborting with the following error from REMOTE host:/ BYTE 15,0 ; tables for GETOPT subroutine DEFINE OPT CHAR,CODE = BYTE CHAR,CODE SET1: ASCII / SET allows you to change the following parameters./ BYTE 15,15,0 NONONO: ASCII /%You cannot CONNECT to your own terminal!/ BYTE 15 ASCII /You must specify the communications TRMDEF when KERMIT is invoked:/ BYTE 15,11 ASCII /e.g. KERMIT MODEM uses the MODEM TRMDEF./ BYTE 15,0 END